home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / emcs1857 / 1857sr~1.zoo / src / cmds.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-02  |  8.9 KB  |  351 lines
  1. /* Simple built-in editing commands.
  2.    Copyright (C) 1985, 1990, 1991 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. /* Modified 1991 for 8-bit character support by Howard Gayle.
  22.  *  See chartab.c for details. */
  23.  
  24.  
  25. #include "config.h"
  26. #include "lisp.h"
  27. #include "chartab.h"
  28. #include "commands.h"
  29. #include "buffer.h"
  30. #include "syntax.h"
  31.  
  32. Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_hook;
  33.  
  34.  
  35. DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  36.   "Move point right ARG characters (left if ARG negative).\n\
  37. On reaching end of buffer, stop and signal error.")
  38.   (n)
  39.      Lisp_Object n;
  40. {
  41.   if (NULL (n))
  42.     XFASTINT (n) = 1;
  43.   else
  44.     CHECK_NUMBER (n, 0);
  45.  
  46.   SET_PT (point + XINT (n));
  47.   if (point < BEGV)
  48.     {
  49.       SET_PT (BEGV);
  50.       Fsignal (Qbeginning_of_buffer, Qnil);
  51.     }
  52.   if (point > ZV)
  53.     {
  54.       SET_PT (ZV);
  55.       Fsignal (Qend_of_buffer, Qnil);
  56.     }
  57.   return Qnil;
  58. }
  59.  
  60. DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  61.   "Move point left ARG characters (right if ARG negative).\n\
  62. On attempt to pass beginning or end of buffer, stop and signal error.")
  63.   (n)
  64.      Lisp_Object n;
  65. {
  66.   if (NULL (n))
  67.     XFASTINT (n) = 1;
  68.   else
  69.     CHECK_NUMBER (n, 0);
  70.  
  71.   XSETINT (n, - XINT (n));
  72.   return Fforward_char (n);
  73. }
  74.  
  75. DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
  76.   "If point is on line i, move to the start of line i + ARG.\n\
  77. If there isn't room, go as far as possible (no error).\n\
  78. Returns the count of lines left to move.\n\
  79. With positive ARG, a non-empty line at the end counts as one line\n\
  80.   successfully moved (for the return value).")
  81.   (n)
  82.      Lisp_Object n;
  83. {
  84.   int pos2 = point;
  85.   int pos;
  86.   int count, shortage, negp;
  87.  
  88.   if (NULL (n))
  89.     count = 1;
  90.   else
  91.     {
  92.       CHECK_NUMBER (n, 0);
  93.       count = XINT (n);
  94.     }
  95.  
  96.   negp = count <= 0;
  97.   pos = scan_buffer (NEWLINE, pos2, count - negp, &shortage);
  98.   if (shortage > 0
  99.       && (negp
  100.       || (ZV > BEGV
  101.           && FETCH_CHAR (pos - 1) != NEWLINE)))
  102.     shortage--;
  103.   SET_PT (pos);
  104.   return make_number (negp ? - shortage : shortage);
  105. }
  106.  
  107. DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
  108.   0, 1, "p",
  109.   "Move point to beginning of current line.\n\
  110. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  111. If scan reaches end of buffer, stop there without error.")
  112.   (n)
  113.      Lisp_Object n;
  114. {
  115.   if (NULL (n))
  116.     XFASTINT (n) = 1;
  117.   else
  118.     CHECK_NUMBER (n, 0);
  119.  
  120.   Fforward_line (make_number (XINT (n) - 1));
  121.   return Qnil;
  122. }
  123.  
  124. DEFUN ("end-of-line", Fend_of_line, Send_of_line,
  125.   0, 1, "p",
  126.   "Move point to end of current line.\n\
  127. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  128. If scan reaches end of buffer, stop there without error.")
  129.   (n)
  130.      Lisp_Object n;
  131. {
  132.   register int pos;
  133.   register int stop;
  134.  
  135.   if (NULL (n))
  136.     XFASTINT (n) = 1;
  137.   else
  138.     CHECK_NUMBER (n, 0);
  139.  
  140.   if (XINT (n) != 1)
  141.     Fforward_line (make_number (XINT (n) - 1));
  142.  
  143.   pos = point;
  144.   stop = ZV;
  145.   while (pos < stop && FETCH_CHAR (pos) != NEWLINE) pos++;
  146.   SET_PT (pos);
  147.  
  148.   return Qnil;
  149. }
  150.  
  151. DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
  152.   "Delete the following ARG characters (previous, with negative arg).\n\
  153. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  154. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  155. ARG was explicitly specified.")
  156.   (n, killflag)
  157.      Lisp_Object n, killflag;
  158. {
  159.   CHECK_NUMBER (n, 0);
  160.  
  161.   if (NULL (killflag))
  162.     {
  163.       if (XINT (n) < 0)
  164.     {
  165.       if (point + XINT (n) < BEGV)
  166.         Fsignal (Qbeginning_of_buffer, Qnil);
  167.       else
  168.         del_range (point + XINT (n), point);
  169.     }
  170.       else
  171.     {
  172.       if (point + XINT (n) > ZV)
  173.         Fsignal (Qend_of_buffer, Qnil);
  174.       else
  175.         del_range (point, point + XINT (n));
  176.     }
  177.     }
  178.   else
  179.     {
  180.       call1 (Qkill_forward_chars, n);
  181.     }
  182.   return Qnil;
  183. }
  184.  
  185. DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
  186.   1, 2, "p\nP",
  187.   "Delete the previous ARG characters (following, with negative ARG).\n\
  188. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  189. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  190. ARG was explicitly specified.")
  191.   (n, killflag)
  192.      Lisp_Object n, killflag;
  193. {
  194.   CHECK_NUMBER (n, 0);
  195.   return Fdelete_char (make_number (-XINT (n)), killflag);
  196. }
  197.  
  198. DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
  199.   "Insert this character.  Prefix arg is repeat-count.")
  200.   (arg)
  201.      Lisp_Object arg;
  202. {
  203.   CHECK_NUMBER (arg, 0);
  204.  
  205.   while (XINT (arg) > 0)
  206.     {
  207.       XFASTINT (arg)--;        /* Ok since old and new vals both nonneg */
  208.       self_insert_internal (last_command_char, XFASTINT (arg) != 0);
  209.     }
  210.   return Qnil;
  211. }
  212.  
  213. DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
  214.   "Insert a newline.  With arg, insert that many newlines.\n\
  215. In Auto Fill mode, can break the preceding line if no numeric arg.")
  216.   (arg1)
  217.      Lisp_Object arg1;
  218. {
  219.   int flag;
  220.   Lisp_Object arg;
  221.   char c1 = NEWLINE;
  222.  
  223.   arg = Fprefix_numeric_value (arg1);
  224.  
  225.   if (!NULL (current_buffer->read_only))
  226.     Fsignal (Qbuffer_read_only, Qnil);
  227.  
  228.   /* Inserting a newline at the end of a line
  229.      produces better redisplay in try_window_id
  230.      than inserting at the beginning of a line,
  231.      and the textual result is the same.
  232.      So if at beginning, pretend to be at the end.
  233.      Must avoid self_insert_internal in that case since point is wrong.
  234.      Luckily self_insert_internal's special features all do nothing in that case.  */
  235.  
  236.   flag = point > BEGV && FETCH_CHAR (point - 1) == NEWLINE;
  237.   if (flag)
  238.     SET_PT (point - 1);
  239.  
  240.   while (XINT (arg) > 0)
  241.     {
  242.       if (flag)
  243.     insert (&c1, 1);
  244.       else
  245.     self_insert_internal (NEWLINE, !NULL (arg1));
  246.       XFASTINT (arg)--;        /* Ok since old and new vals both nonneg */
  247.     }
  248.  
  249.   if (flag)
  250.     SET_PT (point + 1);
  251.  
  252.   return Qnil;
  253. }
  254.  
  255. self_insert_internal (c1, noautofill)
  256.      char c1;
  257.      int noautofill;
  258. {
  259.   extern Lisp_Object Fexpand_abbrev ();
  260.   int hairy = 0;
  261.   Lisp_Object tem;
  262.   register enum syntaxcode synt;
  263.   register int c = c1;
  264.  
  265.   if (!NULL (current_buffer->overwrite_mode)
  266.       && point < ZV
  267.       && c != NEWLINE && FETCH_CHAR (point) != NEWLINE
  268.       && (FETCH_CHAR (point) != HTAB
  269.       || XINT (current_buffer->tab_width) <= 0
  270.       || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
  271.     {
  272.       del_range (point, point + 1);
  273.       hairy = 1;
  274.     }
  275.   if (!NULL (current_buffer->abbrev_mode)
  276.       && SYNTAX (c) != Sword
  277.       && NULL (current_buffer->read_only)
  278.       && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
  279.     {
  280.       tem = Fexpand_abbrev ();
  281.       if (!NULL (tem))
  282.     hairy = 1;
  283.     }
  284.   if ((c == ' ' || c == NEWLINE)
  285.       && !noautofill
  286.       && !NULL (current_buffer->auto_fill_hook)
  287.       && current_column () > XFASTINT (current_buffer->fill_column))
  288.     {
  289.       if (c1 != NEWLINE)
  290.     insert (&c1, 1);
  291.       call0 (current_buffer->auto_fill_hook);
  292.       if (c1 == NEWLINE)
  293.     insert (&c1, 1);
  294.       hairy = 1;
  295.     }
  296.   else
  297.     insert (&c1, 1);
  298.   synt = SYNTAX (c);
  299.   if ((synt == Sclose || synt == Smath)
  300.       && !NULL (Vblink_paren_hook) && FROM_KBD)
  301.     {
  302.       call0 (Vblink_paren_hook);
  303.       hairy = 1;
  304.     }
  305.   return hairy;
  306. }
  307.  
  308. /* module initialization */
  309.  
  310. syms_of_cmds ()
  311. {
  312.   Qkill_backward_chars = intern ("kill-backward-chars");
  313.   staticpro (&Qkill_backward_chars);
  314.  
  315.   Qkill_forward_chars = intern ("kill-forward-chars");
  316.   staticpro (&Qkill_forward_chars);
  317.  
  318.   DEFVAR_LISP ("blink-paren-hook", &Vblink_paren_hook,
  319.     "Function called, if non-nil, whenever a char with closeparen syntax is self-inserted.");
  320.   Vblink_paren_hook = Qnil;
  321.  
  322.   defsubr (&Sforward_char);
  323.   defsubr (&Sbackward_char);
  324.   defsubr (&Sforward_line);
  325.   defsubr (&Sbeginning_of_line);
  326.   defsubr (&Send_of_line);
  327.  
  328.   defsubr (&Sdelete_char);
  329.   defsubr (&Sdelete_backward_char);
  330.  
  331.   defsubr (&Sself_insert_command);
  332.   defsubr (&Snewline);
  333. }
  334.  
  335. keys_of_cmds ()
  336. {
  337.   int n;
  338.  
  339.   ndefkey (Vglobal_map, Ctl('M'), "newline");
  340.   ndefkey (Vglobal_map, Ctl('I'), "self-insert-command");
  341.   for (n = 040; n < 0177; n++)
  342.     ndefkey (Vglobal_map, n, "self-insert-command");
  343.  
  344.   ndefkey (Vglobal_map, Ctl ('A'), "beginning-of-line");
  345.   ndefkey (Vglobal_map, Ctl ('B'), "backward-char");
  346.   ndefkey (Vglobal_map, Ctl ('D'), "delete-char");
  347.   ndefkey (Vglobal_map, Ctl ('E'), "end-of-line");
  348.   ndefkey (Vglobal_map, Ctl ('F'), "forward-char");
  349.   ndefkey (Vglobal_map, 0177, "delete-backward-char");
  350. }
  351.